Aminet 39/Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso/Aminet/gfx/edit/PfPaint_V2.lha/PerfectPaint/rexx/box/Funny_Border.rx

Text File | 1999-12-09 | 3.1 KB | 182 lines

/* Box arexx test */

    options results
  parse ARG Port x1 y1 x2 y2 b
    ADDRESS value Port

    ADDRESS COMMAND
    type=0
    if EXISTS('PerfectPaint:Prefs/Rexx_Prefs/Funny_Border') THEN DO
        IF OPEN('lfile','PerfectPaint:Prefs/Rexx_Prefs/Funny_Border', "R") then DO
            type = READLN('lfile')
            CALL CLOSE('lfile')
        END
    END

    ADDRESS value Port

    pp_DialogInit 250 60 "*Funny*Border*" 1
        pp_Cycle 0 100 8 100 16 "Type" 1 "1|2|3|4|Light|Shade" type
    pp_Dialog
    rc=result
    if rc=0 then
        do
            EXIT
        end

    pp_GetDialog 0
    type=result

    CALL SavePrefs('Funny_Border',type)
    ADDRESS value Port

    pp_updateundo

if type=0 then DO
    xb=trunc(((abs(x1-x2)+1)*10)/100);yb=trunc(((abs(y1-y2)+1)*10)/100)
    ab=xb
    if xb>yb then
    do
    ab=yb
    end
    pp_startpoly
    pp_addpoly x1 y1+ab
    pp_addpoly x1+ab y1
    pp_addpoly x2-ab y1
    pp_addpoly x2 y1+ab
    pp_addpoly x2 y2-ab
    pp_addpoly x2-ab y2
    pp_addpoly x1+ab y2
    pp_addpoly x1 y2-ab
    pp_addpoly x1 y1+ab
    pp_endpoly
END

if type=1 then DO
    xb=trunc(((abs(x1-x2)+1)*10)/100)
    yb=trunc(((abs(y1-y2)+1)*10)/100)
    ab=xb
    if xb>yb then
    do
        ab=yb
    end
    pp_line x1+ab y1 x2-ab y1
    pp_line x2 y1+ab x2 y2-ab
    pp_line x2-ab y2 x1+ab y2
    pp_line x1 y2-ab x1 y1+ab

    pp_spline x1 y1+ab x1+ab y1 x1 y1
    pp_spline x2-ab y1 x2 y1+ab x2 y1
    pp_spline x2 y2-ab x2-ab y2 x2 y2
    pp_spline x1+ab y2 x1 y2-ab x1 y2
END

if type=2 then DO
    xb=trunc(((abs(x1-x2)+1)*10)/100)
    yb=trunc(((abs(y1-y2)+1)*10)/100)
    ab=xb
    if xb>yb then
    do
        ab=yb
    end
    ab2=trunc(ab/3)

    pp_line x1+ab y1 x2-ab y1
    pp_line x2 y1+ab x2 y2-ab
    pp_line x2-ab y2 x1+ab y2
    pp_line x1 y2-ab x1 y1+ab

    pp_spline x1 y1+ab x1+ab y1 x1+ab2 y1+ab2
    pp_spline x2-ab y1 x2 y1+ab x2-ab2 y1+ab2
    pp_spline x2 y2-ab x2-ab y2 x2-ab2 y2-ab2
    pp_spline x1+ab y2 x1 y2-ab x1+ab2 y2-ab2
END

if type=3 then DO
    xb=trunc(((abs(x1-x2)+1)*20)/100)
    yb=trunc(((abs(y1-y2)+1)*20)/100)
    ab=xb
    if xb>yb then
    do
        ab=yb
    end
    ac=trunc(ab/2)
    pp_STARTpoly
    pp_ADDpoly x1 y1
    pp_ADDpoly x1+ac y1
    pp_ADDpoly x1+ac y1+ab
    pp_ADDpoly x1 y1+ab
    pp_ADDpoly x1 y2-ab
    pp_ADDpoly x1+ac y2-ab
    pp_ADDpoly x1+ac y2
    pp_ADDpoly x1 y2
    pp_ADDpoly x1 y2-ac
    pp_ADDpoly x1+ab y2-ac
    pp_ADDpoly x1+ab y2
    pp_ADDpoly x2-ab y2
    pp_ADDpoly x2-ab y2-ac
    pp_ADDpoly x2 y2-ac
    pp_ADDpoly x2 y2
    pp_ADDpoly x2-ac y2
    pp_ADDpoly x2-ac y2-ab
    pp_ADDpoly x2 y2-ab
    pp_ADDpoly x2 y1+ab
    pp_ADDpoly x2-ac y1+ab
    pp_ADDpoly x2-ac y1
    pp_ADDpoly x2 y1
    pp_ADDpoly x2 y1+ac
    pp_ADDpoly x2-ab y1+ac
    pp_ADDpoly x2-ab y1
    pp_ADDpoly x1+ab y1
    pp_ADDpoly x1+ab y1+ac
    pp_ADDpoly x1 y1+ac
    pp_ADDpoly x1 y1
    pp_ENDpoly
END

if type=4 then DO
    pp_PenType 0
    PP_EffectOn
    j=0
    do i=90 to 10 by -10
        pp_Light i
        pp_Box x1+j y1+j x2-j y2-j
        j=j+1
    end
    pp_EffectOff
END

if type=5 then DO
    pp_PenType 0
    PP_EffectOn
    j=0
    do i=90 to 10 by -10
        pp_Shade i
        pp_Box x1+j y1+j x2-j y2-j
        j=j+1
    end
    pp_EffectOff
END

EXIT

SavePrefs: PROCEDURE

    Prefname='PerfectPaint:Prefs/Rexx_Prefs/'||ARG(1)

    if EXISTS(Prefname) THEN DO
        ADDRESS COMMAND
        'delete >nil: '||Prefname
    END

    IF OPEN('pfile',PrefName,'W') THEN DO

    do i=2 to ARG()
        CALL WRITELN('pfile',ARG(i))
    end

    CALL CLOSE('pfile')

RETURN